home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / ems_tp.zip / EMS_DEMO.PAS
Pascal/Delphi Source File  |  1989-08-15  |  9KB  |  222 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  7.  
  8. { $p256}
  9. {!^ 1. Directives A,B,C,D,F,G,P,U,W,X are obsolete or changed in meaning}
  10. Program ems_demo;
  11. { This program is a demo of the use of EMS procedures in Turbo Pascal.   }
  12. { Public Domain by Peter Handsman.  GEnie Mail:  P.Handsman              }
  13. { Any problems or damage this program does is NOT my fault!              }
  14. { I therefore take no responsibility whatsoever.                         }
  15. { Keeping that in mind I welcome and comments or questions or bug reports}
  16. {                                                                        }
  17. { The program start's out by checking if you have EMS installed...       }
  18. { Moves on to a short demo of allocating memory and what happens to      }
  19. { free EMS memory.  Then Runs the Sieve of Erat(who knows?) with the     }
  20. { data array in an allocated part of EMS memory.                         }
  21. {                                                                        }
  22. { EMS memory is the specification by Lotus/Intel/Microsoft for a banked  }
  23. { memory scheme.  The PD file Limspec.arc defines the spec.              }
  24. { This program was written on a IBM PC with a AST Rampage! board         }
  25. { (But it does not use the extended spec's) and the source is in         }
  26. { Turbo Pascal 3.01a.                                                    }
  27.  
  28.  
  29. Uses
  30.   Dos; {Unit found in TURBO.TPL}
  31.  
  32. const
  33.    SIZE = 8190;      { Used by the prime sieve.}
  34.  
  35. type
  36.    registers= record                        { 8088 regester type.        }
  37.      ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
  38. {! 2. Instead use the Registers type from the^ Turbo 5.0 DOS unit.}
  39.    end;
  40.    handle_rec=record                        { Handle map record type.    }
  41.      handle:  integer;
  42.      numpages:integer;
  43.    end;
  44.    pages=     array[0..255] of handle_rec;
  45.    pages_ptr= ^pages;
  46.    arr =      record                        { the following types are    }
  47.      flag:    array[0..8191] of byte;       { used by the prime sieve.   }
  48.    end;
  49.    parr =     ^arr;
  50.  
  51. var
  52.    han:       integer;     { Holds the handle returned by alloc}
  53.    regs:      registers;   { Holds the 8088 regester set.      }
  54.    handles:   integer;     { Holds number of used handles.     }
  55.    map:       pages_ptr;   { Ptr to ems page map.              }
  56.    segm:      integer;     { Holds segment of ems window.      }
  57.    f:         parr;        { Ptr to prime data array.          }
  58.    j,k,count: integer;     { Misc var's for prime sieve.       }
  59.    prime:     integer;     { Holds prime number.               }
  60.  
  61. procedure error_handler(error_num:integer);
  62. { This is a lame error handler... all it does is print out a   }
  63. { message and halt, setting ERRORLEVEL to the error number.    }
  64. { Since some errors are not fatel, i.e. not enough free pages  }
  65. { You should include more code here to trap specific errors.   }
  66. { A listing of what the error numbers mean is in the           }
  67. { Limspec.arc public domain file...                            }
  68. begin
  69.      writeln('EMS Error number: ',error_num,' has occured...');
  70.      halt(error_num)
  71. end;
  72.  
  73. function cnvt_bcd_bytes(i:integer):real;
  74. { This function takes a bcd number then converts it to bytes.  }
  75. { The bcd number is of the format xxxxyyyy in binary where     }
  76. { the number is the number of pages (16k to a page)            }
  77. begin
  78.      cnvt_bcd_bytes:=(256.0*hi(i)+lo(i))*1024.0*16.0;
  79. end;
  80.  
  81. function ems_installed:boolean;
  82. { This function checks to see if a ems board is installed...   }
  83. { If you have a ems board and haven't installed the device     }
  84. { which controls it, (the EMM manager) then it will respond    }
  85. { as if you don't have such a board.                           }
  86. var
  87.    f:file;
  88. begin
  89.      assign(f, 'EMMXXXX0');
  90.      {$I-} reset(f) {$I+} ;
  91.      ems_installed:=(ioresult=0)
  92. {! 3. IOResult now re^turns different values corresponding to DOS error codes.}
  93. end;
  94.  
  95. procedure emm_call(var regs:registers; ah:integer);
  96. { This procedure makes a call to the emm device and executes   }
  97. { the function specified in the ah parameter... also it calls  }
  98. { the error_handler if the emm manager returns an error msg.   }
  99. begin
  100.      regs.ax:=ah*$100;
  101.      intr($67,Dos.Registers(regs));
  102. {! 4. Paramete^r to Intr must be of the type Registers defined in DOS unit.}
  103.      if hi(regs.ax)<>0 then error_handler(hi(regs.ax));
  104. end;
  105.  
  106. procedure print_map(var page_map:pages; handles:integer);
  107. { This procedure obtains the page_map from the EMM device and  }
  108. { prints it out in a readable form.                            }
  109. var
  110.       h:integer;
  111. begin
  112.      regs.es:=seg(page_map);   { call with the address where   }
  113.      regs.di:=ofs(page_map);   { you want the map to be placed.}
  114.      regs.bx:=0;
  115.      emm_call(regs,$4d);
  116.      writeln;
  117.      writeln('Handle   bytes');
  118.      writeln('------   ------');
  119.      for h:=0 to handles-1 do
  120.          writeln(h:5, '  ',cnvt_bcd_bytes(page_map[h].numpages):8:0)
  121. end;
  122.  
  123. procedure show_info;
  124. { This procedure prints out some information on the current    }
  125. { state of the ems memory and the memory handler.              }
  126. begin
  127.      emm_call(regs,$4b);     { Get the total number of handles }
  128.      handles:=regs.bx;       { in use.                         }
  129.      getmem(map,4*handles);
  130.      print_map(map^,handles);{ Get the free and total space.   }
  131.      emm_call(regs,$42);
  132.      writeln(' free: ',cnvt_bcd_bytes(regs.bx):8:0);
  133.      writeln('total: ',cnvt_bcd_bytes(regs.dx):8:0);
  134.      emm_call(regs,$46);
  135.      writeln('The EMM version is: ',lo(regs.ax)/16:2:0,'.',lo(regs.ax) mod 16:1)
  136. end;
  137.  
  138. procedure alloc(num:integer;var handle:integer);
  139. { This procedure allocates num pages(16k) of ems memory which  }
  140. { can be refered to by the map handle.                         }
  141. { WARNING: if you allocate memory and don't deallocate it the  }
  142. {          memory will be lost till power off.                 }
  143. begin
  144.      regs.bx:=num;
  145.      emm_call(regs,$43);
  146.      handle:=regs.dx
  147. end;
  148.  
  149. procedure unalloc(handle:integer);
  150. { This procedure unallocates ems memory. You MUST have the     }
  151. { handle number or you can't unallocate anything!              }
  152. begin
  153.      regs.dx:=handle;
  154.      emm_call(regs,$45);
  155. end;
  156.  
  157. procedure get_page_frame(var address:integer);
  158. { This procedure gets the segment address of the start of where}
  159. { the ems memory will be maped onto the normal 8088 memory     }
  160. { address space...                                             }
  161. begin
  162.      emm_call(regs,$41);
  163.      address:=regs.bx
  164. end;
  165.  
  166. procedure set_page(logical_page,physical_page,handle:integer);
  167. { This procedure sets the logical page onto one of the four    }
  168. { physical pages which the normal lim spec's provide for.      }
  169. {                                                              }
  170. { Logical_Page  is from 0 to the number of pages allocated     }
  171. {               for that handle-1.                             }
  172. { Physical_Page is one of the four(0-3) pages. This will over- }
  173. {               write any previous calls so use differnt ones  }
  174. {               until you don't need the old logical page for  }
  175. {               a while.                                       }
  176. {                                                              }
  177. { Offsets from the page_frame segment are:                     }
  178. { page:offset  0:0000 1:4000 2:8000 3:C0000 in hex.            }
  179. begin
  180.      regs.ax:=($44*$100)+physical_page;
  181.      regs.bx:=logical_page;
  182.      regs.dx:=handle;
  183.      intr($67,Dos.Registers(regs));
  184.      if hi(regs.ax)<>0 then error_handler(hi(regs.ax))
  185. end;
  186.  
  187. procedure sieve(f:parr);
  188. { This is a sieve demo... using a array in EMS memory.     }
  189. begin
  190.      writeln(' interations: 1 ') ;
  191.      count:=0;
  192.      for j:=0 to SIZE do f^.flag[j]:=1;
  193.      for j:=0 to SIZE do
  194.          if f^.flag[j]=1 then begin
  195.             prime:= j + j + 3 ;
  196.             write(prime,' ');        { Comment out this line to drop prime printing}
  197.             k:=j+prime;
  198.             while (k<=size) do begin
  199.                   f^.flag[k]:=0;
  200.                   k:=k+prime
  201.             end;
  202.             count:=count+1
  203.          end;
  204.      writeln('Primes found.=', count )
  205. end;
  206.  
  207. begin
  208.      if ems_installed then begin      { Otherwise just print out msg.}
  209.         show_info;                    { Trivial show of just what    }
  210.         alloc(2,han);                 { happens to free ems memory...}
  211.         show_info;                    {             .                }
  212.         unalloc(han);                 {             .                }
  213.         show_info;                    {             .                }
  214.         alloc(1,han);
  215.         get_page_frame(segm);         { Setup for ems memory usage.  }
  216.         set_page(0,0,han);            { Set logical page to physical.}
  217.         f:=ptr(segm,$0000);           { Set ptr to absolute address. }
  218.         sieve(f);                     { For above see p207 in tpas manual}
  219.         unalloc(han);
  220.      end else writeln('No EMS manager installed.')
  221. end.
  222.